home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / intrfc62.zip / NAMELIST.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-14  |  21KB  |  745 lines
  1. {$N+}
  2. unit namelist;
  3. { These are the routines that print the name definitions }
  4.  
  5. interface
  6.  
  7. uses
  8.   dump,util,globals,loader,head,nametype;
  9.  
  10. var
  11.   last_kind : byte;
  12.   in_function : boolean;
  13.  
  14. procedure print_name_list(obj_list:list_ptr);
  15. procedure print_obj(obj:obj_ptr);
  16. procedure write_type_def(def:type_def_ptr);
  17. procedure write_type_info(var name:string; obj:obj_ptr; info:type_info_ptr);
  18. function find_type(unit_rec:unit_list_ptr;def_ofs:word):obj_ptr;
  19. procedure write_var_type(type_unit,type_def_ofs:word);
  20. procedure write_var_info(var name:string; info:var_info_ptr);
  21. procedure write_args(arg:arg_ptr; num_args:word);
  22. procedure write_proc_type(var name:string; flags:code_flags; info:func_type_ptr);
  23. procedure write_proc_info(var name:string; info:func_info_ptr);
  24. procedure write_const_info(var name:string; info:const_info_ptr);
  25. procedure write_system_type(var name:string; kind:byte; info:system_info_ptr);
  26. procedure write_general(kind:byte; title,name,suffix:string);
  27. function find_name(unit_rec:unit_list_ptr;info_ofs:word):string;
  28. {  Unreliable way to get a name from a pointer to its info }
  29.  
  30. implementation
  31.  
  32. uses
  33.   blocks;
  34.  
  35. const
  36.   semicrlf = ';'+^M+^J;
  37.  
  38. function obj_ofs(obj:pointer):word;
  39. begin
  40.   obj_ofs := ptr_diff(obj,buffer);
  41. end;
  42.  
  43. procedure write_type_def(def:type_def_ptr);
  44. var
  45.   i : integer;
  46.   l : longint;
  47.   save_kind : byte;
  48.   field_list : list_ptr;
  49.   current : list_ptr;
  50.   obj : obj_ptr;
  51.   no_name : string;
  52.   save_in_array : boolean;
  53. begin
  54.   with def^ do
  55.   begin
  56.     if base_type in [1,2,4,6,8,$a,$e,$f,$10,$11,$12,$13,$15,$18,$1a,$1b,
  57.                      $21,$22,$23] then
  58.       case base_type of
  59.         1 : write('untyped');
  60.         2 : write('shortint');
  61.         4 : write('integer');
  62.         6 : write('longint');
  63.         8 : write('byte');
  64.        $a : write('word');
  65.        $e : write('single');
  66.        $f : write('double');
  67.       $10 : write('extended');
  68.       $11 : write('real');
  69.       $12 : write('boolean');
  70.       $13 : write('char');
  71.       $15 : write('comp');
  72.       $18 : write('text');
  73.       $1a : write('pointer');
  74.       $1b : write('string');
  75.       { TPW types }
  76.       $21 : write('wordbool');
  77.       $22 : write('longbool');
  78.       $23 : write('pchar');
  79.     end
  80.     else
  81.     begin
  82.       if base_type <> 0 then
  83.         write('{ unrecognized base type ',hexbyte(base_type),'}');
  84.       case type_type of
  85.         0 : write('untyped');
  86.         1 : begin                  {Array}
  87.               write('array[');
  88.               write_var_type(index_unit,index_ofs);
  89.               write('] of ');
  90.               write_var_type(element_unit,element_ofs);
  91.             end;
  92.         2 : begin                  {Record}
  93.               save_kind := last_kind;
  94.               last_kind := record_id;
  95.               writeln ('Record ');
  96.  
  97.               build_list(field_list,buffer,add_offset(buffer,hash_ofs));
  98.  
  99.               current := field_list;
  100.               inc(indentation,2);
  101.               while current^.offset < $ffff do
  102.               begin
  103.                 obj := add_offset(buffer,current^.offset);
  104.                 print_obj(obj);
  105.                 current := current^.next;
  106.               end;
  107.               dec(indentation);
  108.               indent;
  109.               dec(indentation);
  110.               write('end');
  111.               last_kind := save_kind;
  112.             end;
  113.  
  114.         3 : begin                  {Object}
  115.               save_kind := last_kind;
  116.               last_kind := object_id;
  117.               write ('Object');
  118.               if parent_unit <> 0 then
  119.               begin
  120.                 write('(');
  121.                 write_var_type(parent_unit,parent_ofs);
  122.                 write(')');
  123.               end;
  124.               write(tab,'{ vmt block ',hexword(handle));
  125.               if w10 <> 0 then
  126.                 write(' w10=',hexword(w10));
  127.               writeln('}');
  128.  
  129.               build_list(field_list,buffer,add_offset(buffer,hash_ofs));
  130.  
  131.               inc(indentation,2);
  132.               current := field_list;
  133.               while current^.offset < $ffff do
  134.               begin
  135.                 obj := add_offset(buffer,current^.offset);
  136.                 print_obj(obj);
  137.                 current := current^.next;
  138.               end;
  139.               dec(indentation);
  140.               indent;
  141.               write('end');
  142.               dec(indentation);
  143.               last_kind := save_kind;
  144.             end;
  145.  
  146.         4 : begin                  {File}
  147.               write('file');
  148.               if base_unit <> 0 then
  149.               begin
  150.                 write(' of ');
  151.                 write_var_type(base_unit,base_ofs);
  152.               end;
  153.             end;
  154.         5 : write('built-in text type');
  155.         6 : begin                  {function/procedure}
  156.               no_name := '';
  157.               write_proc_type(no_name,[],func_type_ptr(addr(return_ofs)));
  158.               writeln;
  159.             end;
  160.         7 : begin                  {Set}
  161.               write('set of ');
  162.               write_var_type(base_unit,base_ofs);
  163.             end;
  164.         8 : begin                  {Pointer}
  165.               write('^');
  166.               write_var_type(target_unit,target_ofs);
  167.             end;
  168.  
  169.         9 : begin                  {String}
  170.               write('string[',size-1,']');
  171.               {N.B. actually record is like array of char, but "string" with
  172.                     no length is different.}
  173.             end;
  174.        10 : write('built-in ',size,' byte 8087 type');    {8087}
  175.        11 : write('built-in 6-byte real');
  176.        12 : begin                  {Range}
  177.               write(lower,'..',upper);
  178.             end;
  179.        13 : write('built-in boolean');
  180.        14 : write('built-in char type');
  181.        15 : begin                  {Enumeration or subrange}
  182.               if (type_unit = unit_list[1]^.own_record)
  183.                  and (type_ofs = obj_ofs(def)) then
  184.               begin
  185.                 { Must be first definition }
  186.                 write('(');
  187.                 {  Assume following records are constant declarations  }
  188.                 obj := add_offset(def,30);
  189.                 for l:=lower to upper-1 do
  190.                 begin
  191.                   write(obj^.name,',');
  192.                   obj:=add_offset(obj,12+length(obj^.name));
  193.                 end;
  194.                 write(obj^.name,')');
  195.               end
  196.               else
  197.               begin
  198.                 { Must be subrange }
  199.                 obj := add_offset(get_unit(type_unit)^.buffer,type_ofs);
  200.                 obj := add_offset(obj,24);
  201.                 i := 0;
  202.                 while i < def^.lower do
  203.                 begin
  204.                   obj:=add_offset(obj,12+length(obj^.name));
  205.                   inc(i);
  206.                 end;
  207.                 write(obj^.name);
  208.                 while i < def^.upper do
  209.                 begin
  210.                   obj:=add_offset(obj,12+length(obj^.name));
  211.                   inc(i);
  212.                 end;
  213.                 write('..',obj^.name);
  214.               end;
  215.             end;
  216.        else
  217.             begin
  218.               writeln('Type definition of type ',type_type, 'otherbyte=',
  219.                       other_byte,'size=',size);
  220.               indent;
  221.               write(' junk=');
  222.               for i:=3 to 8 do
  223.                 write(who_knows[i]:6);
  224.               writeln;
  225.             end;
  226.       end;
  227.     end;
  228.   end;
  229. end;
  230.  
  231. procedure write_type_info(var name:string; obj:obj_ptr; info:type_info_ptr);
  232. var
  233.   def_obj : obj_ptr;
  234. begin
  235.   indent;
  236.   if (last_kind <> record_id) and (last_kind <> type_id) then
  237.   begin
  238.     writeln('type');
  239.     indent;
  240.     last_kind := type_id;
  241.   end;
  242.   write(oneindent,name,'=',oneindent);
  243.   with info^ do
  244.     if obj = find_type(get_unit(type_unit),type_def_ofs) then
  245.       write_type_def(add_offset(buffer,type_def_ofs))
  246.     else
  247.       write_var_type(type_unit,type_def_ofs);
  248.   writeln(';');
  249. end;
  250.  
  251. function find_type(unit_rec:unit_list_ptr;def_ofs:word):obj_ptr;
  252. var
  253.   current:list_ptr;
  254.   obj : obj_ptr;
  255.   obj_info : type_info_ptr;
  256. begin
  257.   with unit_rec^ do
  258.   begin
  259.     if (obj_list = nil) and (buffer <> nil) then
  260.       build_list(obj_list,buffer,add_offset(buffer,header_ptr(buffer)^.ofs_hashtable));
  261.     if obj_list <> nil then
  262.     begin
  263.       current := obj_list;
  264.       while current^.offset < $ffff do
  265.       begin
  266.         obj := add_offset(buffer,current^.offset);
  267.         obj_info := add_offset(obj,4+length(obj^.name));
  268.         if     (obj^.obj_type = type_id)
  269.            and (obj_info^.type_def_ofs = def_ofs)
  270.            and (obj_info^.type_unit = own_record) then
  271.         begin
  272.           find_type := obj;
  273.           exit;
  274.         end;
  275.         current := current^.next;
  276.       end;
  277.     end;
  278.     find_type := nil;
  279.   end;
  280. end;
  281.  
  282. function find_name(unit_rec:unit_list_ptr;info_ofs:word):string;
  283. {  Unreliable way to get a name from a pointer to its info }
  284. var
  285.   i:word;
  286.   name:string;
  287. begin
  288.   with unit_rec^ do
  289.   begin
  290.     if buffer <> nil then
  291.       for i:=info_ofs-2 downto 0 do
  292.         if i+buffer^[i]+1 = info_ofs then
  293.         begin
  294.           move(buffer^[i],name[0],buffer^[i]+1);
  295.           find_name := name;
  296.           exit;
  297.         end;
  298.   end;
  299.   find_name := '';
  300. end;
  301.  
  302. procedure write_var_type(type_unit,type_def_ofs:word);
  303. var
  304.   type_obj : obj_ptr;
  305.   unit_ptr : unit_list_ptr;
  306. begin
  307.   if type_unit > 0 then
  308.   begin
  309.     unit_ptr := get_unit(type_unit);
  310.     with unit_ptr^ do
  311.     begin
  312.       if buffer <> nil then
  313.       begin
  314.         type_obj := find_type(unit_ptr,type_def_ofs);
  315.         if type_obj <> nil then
  316.           write(type_obj^.name)
  317.         else
  318.           write_type_def(add_offset(buffer,type_def_ofs));
  319.       end
  320.       else
  321.         write(name,'.ofs',type_def_ofs);
  322.     end;
  323.   end
  324.   else
  325.     write('type_unit not found');
  326. end;
  327.  
  328. procedure write_var_info(var name:string; info:var_info_ptr);
  329. var
  330.   orig_unit:unit_list_ptr;
  331.   f : var_flags;
  332. begin
  333.   indent;
  334.   with info^ do
  335.   begin
  336.     if not (last_kind in [object_id,objpriv_id,record_id]) then
  337.     begin
  338.       f := flags*[const_flag,local,referenced];
  339.       if f = [] then
  340.         write_general(var_id,'var',name,':'+oneindent)
  341.       else if f = [const_flag] then
  342.         write_general(const_id,'const',name,':'+oneindent)
  343.       else if f = [local] then
  344.         write_general(local_id,'local var',name,':'+oneindent)
  345.       else if f = [local,referenced] then
  346.         write_general(referenced_id,'referenced var',name,':'+oneindent)
  347.       else
  348.         write(' var flags = ',hexbyte(byte(flags)),oneindent);
  349.       end
  350.     else
  351.       write(name,':',oneindent);
  352.  
  353.     write_var_type(type_unit,type_def_ofs);
  354.  
  355.     if absolute in flags then
  356.     begin
  357.       write(' absolute ');
  358.       orig_unit := get_unit(in_unit);
  359.       if orig_unit <> nil then
  360.       begin
  361.         if orig_unit <> unit_list[1] then
  362.           write(orig_unit^.name,'.');
  363.         writeln(find_name(orig_unit,offset),';');
  364.       end
  365.       else
  366.         writeln('?????;');
  367.     end
  368.     else
  369.     begin
  370.       if const_flag in flags then
  371.         write('=',oneindent,'?');
  372.       if in_function then
  373.         write(';',tab,'{BP ofs ',integer(offset))
  374.       else
  375.       begin
  376.         write(';',tab,'{ofs ',hexword2(offset));
  377.         if not (last_kind in [record_id,object_id,objpriv_id]) then
  378.           write(' in block ',hexword2(in_unit));
  379.       end;
  380.       writeln('}');
  381.     end;
  382.   end;
  383. end;
  384.  
  385. procedure write_args(arg:arg_ptr;num_args:word);
  386. var
  387.   i:word;
  388. begin
  389.   writeln('(');
  390.   inc(indentation);
  391.   for i:=1 to num_args do
  392.   begin
  393.     with arg^ do
  394.     begin
  395.       indent;
  396.       if referenced in flags then
  397.         write('var ')
  398.       else
  399.         write('    ');
  400.       if flags - [referenced] <> [local] then
  401.       begin
  402.         writeln('{ flags =',hexbyte(byte(flags)),' }');
  403.         indent;
  404.       end;
  405.       write('arg',i,':',oneindent);
  406.       write_var_type(type_unit,type_def_ofs);
  407.       writeln(';');
  408.     end;
  409.     arg := add_offset(arg,sizeof(arg_rec));
  410.   end;
  411.   indent;
  412.   write(')');
  413.   dec(indentation);
  414. end;
  415.  
  416. procedure write_locals(var name:string; info:func_info_ptr);
  417. var
  418.   obj_list : list_ptr;
  419.   save_in_function : boolean;
  420. begin
  421.   if info^.local_hash = 0 then
  422.     exit;
  423.   save_in_function := in_function;
  424.   in_function := true;
  425.   build_list(obj_list,buffer,add_offset(buffer,info^.local_hash));
  426.   inc(indentation);
  427.   indent; writeln('{ ',name,' locals begin...}');
  428.   print_name_list(obj_list);
  429.   indent; writeln('{ ...',name,' locals end.}');
  430.   writeln;
  431.   dec(indentation);
  432.   in_function := save_in_function;
  433. end;
  434.  
  435.  
  436. procedure write_proc_type(var name:string; flags:code_flags; info:func_type_ptr);
  437. var
  438.   proc : boolean;
  439. begin
  440.   with info^ do
  441.   begin
  442.     if (type_def_ofs = 0) and (type_unit = 0) then
  443.       proc := true
  444.     else
  445.       proc := false;
  446.     if construct in flags then
  447.       write('constructor',oneindent,name)
  448.     else if destruct in flags then
  449.       write('destructor',oneindent,name)
  450.     else
  451.       if proc then
  452.         write('procedure',oneindent,name)
  453.       else
  454.         write('function',oneindent,name);
  455.     if info^.num_args > 0 then
  456.       write_args(arg_ptr(add_offset(info,sizeof(func_type_rec))),
  457.                  info^.num_args);
  458.     if not proc then
  459.     begin
  460.       write(':',oneindent);
  461.       write_var_type(type_unit,type_def_ofs);
  462.     end;
  463.   end;
  464.   write(';');
  465. end;
  466.  
  467. procedure write_proc_info(var name:string; info:func_info_ptr);
  468. var
  469.   entry_pt : entry_pt_ptr;
  470.   code : ^word;
  471.   i : word;
  472.   unknown_flags1 : code_flags;
  473.   unknown_flags2 : obj_flags;
  474. begin
  475.   indent;
  476.   with info^ do
  477.   begin
  478.     write_proc_type(name,code_type,func_type_ptr(addr(func_type)));
  479.     entry_pt := add_offset(buffer,header^.ofs_entry_pts+entry_ofs);
  480.  
  481.     if vmt_entry > 0 then
  482.     begin
  483.       write(' virtual');
  484.       if dynamic in obj_type then
  485.         write(' ',vmt_entry);
  486.       write(';');
  487.     end;
  488.  
  489.     if external_code in code_type then
  490.       write(' external;');
  491.     if assembler in code_type then
  492.       write(' assembler;');
  493.  
  494.     if exported in obj_type then
  495.       write(' export;');
  496.     if windows_frame in obj_type then
  497.       write(' W+;');
  498.  
  499.     if from_dll in obj_type then
  500.     begin
  501.       write(' external ''',dll_name(entry_pt^.code_block),'''');
  502.       if by_name in obj_type then
  503.         write(' name ''',dll_name(entry_pt^.offset),'''')
  504.       else
  505.         write(' index ',entry_pt^.offset);
  506.       write(';');
  507.     end
  508.     else
  509.       if by_name in obj_type then
  510.         write(' Unexpected by_name flag!');
  511.  
  512.     if local_code in obj_type then
  513.       write(' local code;');
  514.  
  515.     unknown_flags1 := code_type - [far_entry,inline_code,external_code,
  516.                                   method,construct,destruct,assembler];
  517.     if unknown_flags1 <> [] then
  518.       write(' Unrecognized code flags: ',hexbyte(byte(unknown_flags1)));
  519.     unknown_flags2 := obj_type - [exported,windows_frame,from_dll,by_name,
  520.                                   dynamic,local_code];
  521.     if unknown_flags2 <> [] then
  522.       write(' Unrecognized object flags: ',hexbyte(byte(unknown_flags2)));
  523.     if not (inline_code in code_type) then
  524.     begin
  525.       write(tab,'{ Proc ',hexword2(entry_ofs));
  526.       if not (from_dll in obj_type) then
  527.         write(' Entry ',hexword2(entry_pt^.code_block),':',
  528.                             hexword(entry_pt^.offset));
  529.       writeln('}');
  530.     end
  531.     else
  532.     begin
  533.       writeln;
  534.       indent;
  535.       write(' Inline(');
  536.       code := add_offset(info,sizeof(func_info_rec)
  537.                              +func_type.num_args*sizeof(arg_rec));
  538.       for i:=1 to entry_ofs div 2 - 1 do
  539.       begin
  540.         write('$',hexbyte(hi(code^)):2,'/');
  541.         if lo(code^) <> 0 then
  542.           writeln('Low byte not zero!');
  543.         code := add_offset(code,sizeof(word));
  544.       end;
  545.       writeln('$',hexbyte(hi(code^)):2,');');
  546.       if lo(code^) <> 0 then
  547.         writeln('Low byte not zero!');
  548.     end;
  549.     if f4 in code_type then
  550.       writeln('Unknown flag f4 in code_type');
  551.     if do_locals in active_options then
  552.       write_locals(name,info);
  553.   end;
  554. end;
  555.  
  556. procedure write_const_info(var name:string; info:const_info_ptr);
  557. var
  558.   type_obj : obj_ptr;
  559. begin
  560.   indent;
  561.   if (last_kind <> record_id) and (last_kind <> const_id) then
  562.   begin
  563.     writeln('Const');
  564.     indent;
  565.     last_kind := const_id;
  566.   end;
  567.   write(oneindent,name,'=',oneindent);
  568.   with info^,get_unit(type_unit)^ do
  569.   begin
  570.     if name = 'SYSTEM' then
  571.     case type_def_ofs of
  572.                 { Risky to fix these, but can't see any
  573.                                   other way to type constants }
  574.         $a0:   write('''',stringval,'''');
  575.         $c0:   write(extendval);
  576.        $114:   write(intval);
  577.        $130:   write(boolval);
  578.        $14c:   write('''',charval,'''');
  579.  
  580.         else
  581.           write('?');
  582.     end
  583.     else
  584.       write('?');
  585.   end;
  586.   writeln(';');
  587. end;
  588.  
  589. procedure write_unit_info(var name:string; info:unit_ptr; self:boolean);
  590. begin
  591.   indent;
  592.   if self then
  593.   begin
  594.     write('Unit',oneindent,name,';');
  595.     last_kind := init_id;
  596.   end
  597.   else
  598.   begin
  599.     if last_kind = unit_id then
  600.       write(oneindent,',',name)
  601.     else
  602.     begin
  603.       write('Uses',oneindent,name);
  604.       last_kind := unit_id;
  605.     end;
  606.   end;
  607.   with info^ do
  608.   begin
  609.     writeln(tab,'{ checksum = ',hexword(checksum),'}');
  610.   end;
  611. end;
  612.  
  613. procedure write_system_type(var name:string; kind:byte; info:system_info_ptr);
  614. begin
  615.   case kind of
  616.   sys_proc_id : write('procedure');
  617.   sys_fn_id   : write('function');
  618.   end;
  619.   with info^ do
  620.   begin
  621.     write(oneindent,name,tab,'{ Special index ',hexbyte(addr_ofs));
  622.     if flags <> 0 then
  623.       write(oneindent,'Flags ',hexbyte(flags));  { What are those flags!!??! }
  624.     writeln(' }');
  625.   end;
  626.   last_kind := kind;
  627. end;
  628.  
  629. procedure write_general(kind:byte; title,name,suffix:string);
  630. begin
  631.   if last_kind <> kind then
  632.   begin
  633.     writeln(title);
  634.     last_kind := kind;
  635.     indent;
  636.   end;
  637.   write(oneindent,name,suffix);
  638. end;
  639.  
  640. procedure print_obj(obj:obj_ptr);
  641. var
  642.   j:word;
  643.   obj_info : ^byte_array;
  644.   new_entry : list_ptr;
  645.   info_len,info_ofs : word;
  646.   obj_type : byte;
  647. const
  648.   known_types : set of byte = [var_id,unit_id,const_id,type_id,proc_id,
  649.                                sys_proc_id,sys_fn_id,sys_mem_id,sys_port_id,
  650.                                sys_new_id];
  651.   dump_types  : set of byte = [];
  652. begin
  653.   info_ofs := sizeof(obj_rec)-sizeof(string)+1+length(obj^.name);
  654.   obj_info := add_offset(obj,info_ofs);
  655.   obj_type := obj^.obj_type;
  656.   if (obj_type and $80) <> 0 then
  657.   begin
  658.     if last_kind <> objpriv_id then
  659.     begin
  660.       dec(indentation);
  661.       indent;
  662.       inc(indentation);
  663.       writeln('private');
  664.       last_kind := objpriv_id;
  665.     end;
  666.     obj_type := obj_type and $7F;
  667.   end;
  668.  
  669.   if obj_type in known_types then
  670.   begin
  671.     if obj_type = unit_id then
  672.     begin
  673.       add_unit(obj^.name,unit_ptr(obj_info));
  674.       if unit_ptr(obj_info)^.target = 0 then
  675.         unit_ptr(obj_info)^.target := get_unit_num(obj^.name);
  676.              {  Save our ID there, so references can find the information  }
  677.     end;
  678.  
  679.     case obj_type of  { Strip private bit }
  680.        const_id : write_const_info(obj^.name,pointer(obj_info));
  681.        type_id : write_type_info(obj^.name,obj,pointer(obj_info));
  682.  
  683.        var_id  : write_var_info(obj^.name,pointer(obj_info));
  684.  
  685.        proc_id : begin
  686.                    write_proc_info(obj^.name,pointer(obj_info));
  687.                    if not (last_kind in [object_id,objpriv_id]) then
  688.                      last_kind := proc_id;
  689.                  end;
  690.  
  691.        sys_proc_id,
  692.        sys_fn_id : write_system_type(obj^.name,obj_type,pointer(obj_info));
  693.  
  694.        sys_port_id : begin
  695.                        write_general(sys_port_id,'port array',obj^.name,semicrlf);
  696.                      end;
  697.        sys_mem_id : begin
  698.                       write_general(sys_mem_id,'memory array',obj^.name,semicrlf);
  699.                     end;
  700.        sys_new_id : begin
  701.                       write_general(sys_new_id,'system allocator',obj^.name,semicrlf);
  702.                     end;
  703.        unit_id :   write_unit_info(obj^.name,pointer(obj_info),
  704.                      obj_ofs(obj) = header^.ofs_this_unit)
  705.  
  706.     end; {case}
  707.   end
  708.   else
  709.   begin
  710.     writeln('Unknown kind ',obj_type,oneindent,obj^.name,' with info at ',
  711.             hexword(obj_ofs(obj_info)));
  712.     last_kind := obj_type;
  713.   end;
  714.   if obj_type in dump_types then
  715.   begin
  716.     for j:=0 to 15 do
  717.       write(hexword(obj_ofs(obj_info)+j):5);
  718.     for j:=0 to 15 do
  719.       write(hexbyte(obj_info^[j]):5);
  720.     for j:=16 to 31 do
  721.       write(hexword(obj_ofs(obj_info)+j):5);
  722.     for j:=16 to 31 do
  723.       write(hexbyte(obj_info^[j]):5);
  724.   end;
  725. end;
  726.  
  727. procedure print_name_list(obj_list:list_ptr);
  728. var
  729.   obj : obj_ptr;
  730.   current : list_ptr;
  731.   bytes : ^byte_array;
  732.   j : integer;
  733. begin
  734.   last_kind := init_id;
  735.   current := obj_list;
  736.   while current^.offset < $ffff do
  737.   begin
  738.     obj := add_offset(buffer,current^.offset);
  739.     print_obj(obj);
  740.     current := current^.next;
  741.   end;
  742. end;
  743.  
  744. end.
  745.